home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / a / astrolog / eprog_01.bas < prev    next >
Encoding:
BASIC Source File  |  1996-09-18  |  12.2 KB  |  328 lines
  1. 1     '******* E P R O G    Version 0.1 *******
  2. 2     '********Ephemeridenprogramm*************
  3. 4     fullw 2:clearw 2:gotoxy 0,0
  4. 5     gosub 69 : goto 190
  5. 10    rem Keplergleichung
  6. 11    rem
  7. 12    let p1= 3.14159265: let r1= 180/p1
  8. 13    let k= 0.01720209895
  9. 18    if e0 >= 0.95 then goto 40
  10. 19    if e0 >= 1 then goto 85
  11. 20    let a1= q/(1-e0):let m=k * t * a1^(-1.5)
  12. 21    rem
  13. 22    rem
  14. 23    rem
  15. 24    let f= sgn (m): let m= abs(m)/(2* p1)
  16. 25    let m= (m-int(m))*2*p1*f
  17. 26    if m < 0 then m=m + 2 * p1
  18. 27    let f=1 : if m > p1 then f= -1
  19. 28    if m > p1 then m= 2*p1 - m
  20. 29    let e= p1 / 2 : let d= p1 / 4
  21. 30    for i1= 1 to 23
  22. 31    let m1= e - e0 * sin(e)
  23. 32    let e= e + sgn(m-m1)*d:let d=d/2
  24. 33    next i1
  25. 34    let v= sqr((1+e0)/(1-e0)): let e= e*f
  26. 35    let v= 2*atn (v*sin(e/2)/cos(e/2))
  27. 36    let r=a1 * (1-e0*cos(e))
  28. 38    goto 81
  29. 39    rem 
  30. 40    rem Gaussmethode
  31. 41    rem
  32. 43    let a= sqr((1+9*e0)/10)
  33. 44    let b= 5 * (1-e0)/(1+9*e0)
  34. 45    let c= sqr(5*(1+e0)/(1+9*e0))
  35. 46    let b1= 3*a*k*t / sqr(2*q*q*q)
  36. 47    let b2= 1
  37. 48    let w1= b2*b1: let b3= atn(2/w1)
  38. 49    let t1= sin(b3 / 2)/cos(b3/2)
  39. 50    let s1= sgn(t1): let t1= abs(t1)
  40. 51    let t2= t1^(1/3)* s1: let g= atn(t2)
  41. 52    let s= 2*cos(2*g)/sin(2*g)
  42. 53    let a2= b*s*s : let b0= b2: let b2= 0
  43. 54    if abs(a2) > 0.3 then 19
  44. 55    for j= 0 to 7
  45. 56    let b2= b2+ b(j) * a2 ^j
  46. 57    next j
  47. 58    if abs(b2 - b0) > 1*10^-8 then 48
  48. 59    let c1= 0 
  49. 60    for j= 0 to 7
  50. 61    let c1= c1 + s(j)*a2^j
  51. 62    next j
  52. 63    let c1= sqr (1/c1)
  53. 64    let v1= c * c1 * s: let d1= 1/(1+a2*c1*c1)
  54. 65    let v= 2* atn (v1): let r= q* d1*(1+v1*v1)
  55. 67    goto 81
  56. 68    rem 
  57. 69    rem Koeffizienten
  58. 70    for j= 0 to 7: read b(j): next
  59. 71    for j= 0 to 7: read s(j): next
  60. 72    return
  61. 73    data 1,0,-0.017142857
  62. 74    data -0.003809524,-0.001104267
  63. 75    data -0.000367358,-0.000131675
  64. 76    data -0.000049577,1,-0.8
  65. 77    data 0.04571429,0.0152381
  66. 78    data 0.00562820,0.00218783
  67. 79    data 0.00087905,0.00036155
  68. 80    return
  69. 81    if v < 0 then v= v +2*p1
  70. 84    goto 86
  71. 85    print"Hyperbel!"
  72. 86    return
  73. 190   input"Bahnelemente eingeben(1) oder vorgegebene benutzen(2) ";ba
  74. 192   if ba=1 then goto 206
  75. 194   if ba=2 then goto 2000
  76. 200   rem kometenposition
  77. 206   print"Periheldatum"
  78. 207   gosub 800 : let j9= j: let f9= f
  79. 208   input"Periheldistanz(q)";q
  80. 209   input"Exzentrizität    ";e0
  81. 212   input"Klein-Omega      ";w
  82. 215   input"Gross-Omega      ";n
  83. 218   input"Bahnneigung      ";i
  84. 220   print:input"m(1,1)";mag
  85. 222   input"n     ";nf
  86. 233   let p1= 3.14159265:let r1= p1/180
  87. 236   e= 23.4457889 * r1 
  88. 239   let w= w * r1 :let n=n * r1 :let i= i * r1
  89. 242   gosub 338
  90. 245   print
  91. 246   print"Beobachtungsdatum"
  92. 247   gosub 800: let j1= j: let  f1= f
  93. 248   gosub 500: let t= (j1 - j9) + (f1 - f9)
  94. 249   gosub 10
  95. 254   let x1= r * cos (v): let y1 = r * sin(v)
  96. 260   rem heliozentrisch
  97. 263   let x2= p7 * x1 + q7 * y1
  98. 266   let y2= p8 * x1 + q8 * y1
  99. 269   let z2= p9 * x1 + q9 * y1
  100. 272   rem geozentrisch
  101. 278   let x3= x + x2 : let y3= y + y2: let z3= z + z2
  102. 284   let d3= sqr (x3 * x3 + y3 * y3 + z3 * z3)
  103. 287   let r1= p1 / 180
  104. 290   let a= atn (y3 / x3)/(15 * r1)
  105. 293   if x3 < 0 then let a=a+12
  106. 296   if a< 0 then let a=a+24
  107. 299   let d=atn (z3 / sqr (x3*x3 + y3*y3)) / r1
  108. 301   rem aufrunden
  109. 302   let a=a+0.05/60
  110. 305   let h=int(a):let m= 60 * (a-h)
  111. 308   let m=int(10*m)/10
  112. 311   let s=sgn (d):let d= abs (d)+0.5/60
  113. 314   let d1= int (d) : let m1 = int(60*(d-d1))
  114. 317   let s$="+":if s= -1 then let s$ = "-"
  115. 318   mag2=mag+5*log10(d3)+2.5*nf*log10(r):mag2=mag2*10
  116. 319   mag3=cint(mag2):mag3=mag3/10
  117. 320   print tab(2) chr$(224);tab(17) chr$(235);tab(29) chr$(127);tab(45) "r";        tab(58);"mag"
  118. 322   print"------------------------------------------------------------------"
  119. 325   print tab(1) h;"h ";m;"m";tab(18) s$;d1;chr$(248);m1;"'";tab(29) d3;"AE";      tab(45) r;"AE";tab(58);mag3
  120. 330   goto 245
  121. 332   end
  122. 335   rem p + q
  123. 338   rem
  124. 344   let w1= sin(w): let w2= cos (w)
  125. 347   let n1= sin (n): let n2= cos (n)
  126. 350   let i1= sin (i): let i2= cos (i)
  127. 353   let e1= sin (e): let e2= cos (e)
  128. 356   let p7= w2 * n2 - w1 * n1 * i2
  129. 359   let p8= (w2 * n1 + w1* n2*i2)*e2
  130. 362   let p8= p8 - w1 * i1 * e1
  131. 365   let p9= (w2 * n1 + w1*n2*i2)*e1
  132. 368   let p9= p9 + w1 * i1 * e2
  133. 371   let q7= -w1 * n2 -w2 * n1* i2
  134. 374   let q8= (-w1 * n1 + w2 *n2 * i2) * e2
  135. 377   let q8=q8 - w2 *i1 *e1
  136. 380   let q9=(-w1 * n1 +w2 * n2 * i2)* e1
  137. 383   let q9=q9 + w2 *i1 * e2
  138. 386   return
  139. 410   let x4=a7 * x3 +a8 *y3 + a9 * z3
  140. 413   let y4= b7 * x3 + b8 * y3 + b9 * z3
  141. 416   let z4= c7 * x3 + c8 * y3 + c9 * z3
  142. 419   let x3= x4 : let y3= y4: let z3= z4
  143. 422   return
  144. 500   rem sonnenkoordinaten
  145. 501   rem 
  146. 502   rem
  147. 504   let j8= j-2415020: let r1=3.14159265/180
  148. 505   let t= (j8+f)/36525
  149. 506   let p0=1.396041+0.000308*(t+0.5)
  150. 507   let p0=p0 * (t-0.499998)
  151. 508   let a=100: gosub 529: let g0= a+ 358.475833
  152. 509   let l0=a +279.696678-p0
  153. 510   let a=1336 : gosub 529
  154. 511   let c0= a+ 270.434164 - p0
  155. 512   let a= 162 : gosub 529
  156. 513   let v0=a + 212.603219
  157. 514   let a= 53 : gosub 529 : let m0= a + 319.529425
  158. 515   let a= 8 : gosub 529: let j0=a + 225.444651
  159. 516   let g= g0 + t * (-0.950250 - 0.000150 * t)
  160. 517   let c= c0 + t * (307.883142 - 0.001133 * t)
  161. 518   let l= l0 + t * (0.768920 + 0.000303 * t)
  162. 519   let v= v0 + t * (197.803875 + 0.001286 * t)
  163. 520   let m= m0 + t * (59.8585 + 0.000181 * t)
  164. 521   let j= j0 + t * 154.906654
  165. 522   let g= g * r1 : let c= c* r1: let l= l* r1
  166. 523   let v= v * r1: let m= m * r1: let j= j * r1
  167. 524   gosub 532
  168. 528   return
  169. 529   rem normalisierung
  170. 530   let a= 360 * (a*t-int(a*t)):return
  171. 531   rem 
  172. 532   let x= 0.000011 * cos (2*g-l-2*j)
  173. 533   let x= x + 0.000011 * cos (2*g+l-2*v)
  174. 534   let x= x - 0.000012 * cos (g+l-v)
  175. 535   let x= x - 0.000012 * cos (4*g-l-8*m+3*j)
  176. 536   let x= x + 0.000012 * cos (4*g+l-8*m+3*j)
  177. 537   let x= x - 0.000014 * cos (c-2*l)
  178. 538   let x= x + 0.000017 * cos (c)
  179. 539   let x= x + 0.000018 * sin (2*g+l-2*v)
  180. 540   let x= x - 0.000021 * t * cos ( g+l )
  181. 541   let x= x - 0.000026 * sin (g-l-j)
  182. 542   let x= x + 0.000035 * cos ( 2*g-l)
  183. 543   let x= x + 0.000063 * t * cos (g-l)
  184. 544   let x= x + 0.000105 * cos (2*g+l)
  185. 545   let x= x + 0.008374 * cos (g+l)
  186. 546   let x= x - 0.025127 * cos (g-l)
  187. 547   let x= x + 0.999860 * cos (l)
  188. 548   rem
  189. 549   let y= 0.00010 * sin (2*g+l-2*v)
  190. 550   let y= y - 0.000010 * sin (2*g-l-2*j)
  191. 551   let y= y - 0.000011 * sin (g+l-v)
  192. 552   let y= y + 0.000011 * sin (4*g-l-8*m+3*j)
  193. 553   let y= y + 0.000011 * sin (4*g+l-8*m+3*j)
  194. 554   let y= y + 0.000013 * sin (c-2*l)
  195. 555   let y= y + 0.000016 * sin (c)
  196. 556   let y= y - 0.000017 * cos (2*g+l-2*v)
  197. 557   let y= y - 0.000019 * t * sin(g+l)
  198. 558   let y= y - 0.000024 * cos (g-l-j)
  199. 559   let y= y - 0.000032 * sin (2*g-l)
  200. 560   let y= y - 0.000057 * t * sin (g-l)
  201. 561   let y= y + 0.000097 * sin (2*g+l)
  202. 562   let y= y + 0.007683 * sin (g+l)
  203. 563   let y= y + 0.023053 * sin (g-l)
  204. 564   let y= y + 0.917308 * sin (l)
  205. 565   rem
  206. 566   let z= -0.000010 * cos (g-l-j)
  207. 567   let z= z - 0.000014 * sin (2*g-l)
  208. 568   let z= z - 0.000025 * t * sin (g-l)
  209. 569   let z= z + 0.000042 * sin (2*g+l)
  210. 570   let z= z + 0.003332 * sin (g+l)
  211. 571   let z= z + 0.009998 * sin (g-l)
  212. 572   let z= z + 0.397825 * sin (l)
  213. 573   return
  214. 800   rem jd.
  215. 805   rem
  216. 810   input"Jahr,Monat,Tag";y,m,d
  217. 815   let g= 1
  218. 820   let d1= int(d): let f= d-d1-0.5
  219. 825   let j= -int(7*(int((m+9)/12)+y)/4)
  220. 830   if g= 0 then 850
  221. 835   let s= sgn (m-9): let a= abs(m-9)
  222. 840   let j1= int (y+s*int(a/7))
  223. 845   let j1= -int((int(j1/100)+1)*3/4)
  224. 850   let j= j + int (275*m/9)+d1+g*j1
  225. 855   let j= j + 1721027 + 2 * g + 367 * y
  226. 860   if f >= 0 then 870
  227. 865   let f= f + 1 : let j=j - 1
  228. 870   return
  229. 875   end
  230. 1100  j=2446219:f=0.5684:q=0.526131:e0=0.468462:w=54.8416:n=152.0502:i=9.9219
  231. 1120  if knr=2 then goto 4030
  232. 2000  rem Bahnelemente verschiedener Kometen
  233. 2010  print spc(15) "Inhaltverzeichnis:":print
  234. 2020  print spc(10) "P/Halley           (#1)           1986n Sorrells      (#13)"
  235. 2030  print spc(10) "P/Machholz         (#2)"
  236. 2040  print spc(10) "P/Denning-Fujikawa (#3)"
  237. 2050  print spc(10) "P/Brorsen-Metcalf  (#4)"
  238. 2060  print spc(10) "P/Giacobini-Zinner (#5)"
  239. 2070  print spc(10) "P/Ciffréo          (#6)"
  240. 2080  print spc(10) "P/Shoemaker 3      (#7)"
  241. 2090  print spc(10) "P/Grigg-Skjellerup (#8)"
  242. 2100  print spc(10) "P/Encke            (#9)"
  243. 2110  print spc(10) "P/Temple-Tuttle    (#10)"
  244. 2115  print spc(10) "P/Takamizawa       (#11)"
  245. 2120  print spc(10) "1986l Wilson       (#12)"
  246. 2510  print spc(10) "1984 QA (Planetoid)(#20)"
  247. 2520  print spc(10) "1986 DA (Planetoid)(#21)"
  248. 3000  print:input "Welcher Komet (Kennzahl eingeben)";knr
  249. 3010  if knr=1 then goto 4020
  250. 3020  if knr=2 then goto 4030
  251. 3030  if knr=3 then goto 4040
  252. 3040  if knr=4 then goto 4050
  253. 3045  if knr=5 then goto 4055
  254. 3050  if knr=6 then goto 4060
  255. 3055  if knr=7 then goto 4065
  256. 3060  if knr=8 then goto 4070
  257. 3065  if knr=9 then goto 4075
  258. 3070  if knr=10 then goto 4080
  259. 3075  if knr=11 then goto 4085
  260. 3080  if knr=12 then goto 4090
  261. 3085  if knr=13 then goto 4095
  262. 3500  if knr=20 then goto 4500
  263. 3510  if knr=21 then goto 4510
  264. 4000  '*******BAHNELEMENTE*******
  265. 4019  '***P/HALLEY***
  266. 4020  j=2446470:f=0.95862:q=0.5871013:e0=0.9672750:w=111.84652:n=58.14341
  267. 4021  i=162.23921:j9=j:f9=f:mag=3.1:nf=3.092
  268. 4022  rem Quelle:D.K.Yeomans(JPL),IAUC#4156
  269. 4024  goto 233
  270. 4029  '***P/MACHOLZ***
  271. 4030  j=2446544:f=0.034:q=0.12684:e0=0.95847:w=14.595:n=93.741:i=60.209
  272. 4032  j9=j:f9=f:rem Quelle:S.Nakano(Tokio),IAUC#4223
  273. 4034  goto 233
  274. 4039  '***P/DENNING-FUJIKAWA***
  275. 4040  j=2447012:f=0.600:q=0.76250:e0=0.82180:w=338.260:n=35.860:i=9.430
  276. 4042  j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening),VORLÄUFIG
  277. 4044  goto 233
  278. 4049  '***P/BRORSEN-METCALF***
  279. 4050  j=2447798:f=0.4:q=0.4781:e0=0.9720:w=129.73:n=310.84:i=19.33
  280. 4051  mag=9:nf=4
  281. 4052  j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening),University        of Arizona Press; nur vorläufige Bahnelemente!
  282. 4053  goto 233
  283. 4054  '***P/GIACOBINI-ZINNER***
  284. 4055  j=2446313:f=0.7058:q=1.028255:e0=0.707518:w=172.4856:n=194.7060
  285. 4057  i=31.8784:j9=j:f9=f:mag=11:nf=4:rem Quelle:D.K.Yeomans(JPL),IAUC#4
  286. 4058  goto 233
  287. 4059  '***P/CIFFREO***
  288. 4060  j=2446368:f=0.1291:q=1.701961:e0=0.545690:w=357.6362:n=53.1030:i=13.1074
  289. 4062  j9=j:f9=f:rem Quelle:D.W.E Green(SAO),IAUC#4145
  290. 4063  goto 233
  291. 4064  '***P/SHOEMAKER 3***
  292. 4065  j=2446418:f=0.1056:q=1.794136:e0=0.727579:w=14.8422:n=96.6297:i=6.4076
  293. 4067  j9=j:f9=f:rem Quelle:S.Nakano(Tokio),IAUC#4180
  294. 4068  goto 233
  295. 4069  '***P/GRIGG-SKJELLERUP***
  296. 4070  j=2446966:f=0.6:q=0.9933:e0=0.6648:w=359.31:n=212.63:i=21.11:mag=12.5:nf=4
  297. 4072  j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening); nur vor-         läufige Bahnelemente!
  298. 4073  goto 233
  299. 4074  '***P/ENCKE***
  300. 4075  j=2446993:f=0.9:q=0.3317:e0=0.8499:w=186.26:n=334.03:i=11.93:mag=12:nf=4
  301. 4077  j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),Comets(ed.L.Wilkening);Bahnele-          mente und Helligkeitsparameter nur angenähert!
  302. 4078  goto 233
  303. 4079  '***P/TEMPLE-TUTTLE***
  304. 4080  j=2450871:f=0.9:q=0.9758:e0=0.9056:w=172.52:n=234.56:i=162.48:mag=8:nf=4
  305. 4081  j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),in "Comets"(ed.L.Wilkening);nur          vorläufige Bahnelemente!
  306. 4082  goto 233
  307. 4084  '***P/TAKAMIZAWA***
  308. 4085  j=2445845:f=0.4464:q=1.596101:e0=0.574508:w=147.5732:n=124.2395:i=8.4920
  309. 4086  rem Wenn man den richtigen i-Wert einsetzt, dann"function not yet done!"
  310. 4087  i=i+1:j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),IAUC#3974
  311. 4088  goto 233
  312. 4089  '***1986L WILSON***
  313. 4090  j=2446906:f=0.27867:q=1.1987709:w=238.33253:n=110.95353:e0=1.0:i=147.12800
  314. 4091  mag=3.2:nf=4.6:j9=j:f9=f:rem Quelle:Minor Planet Circular #11236
  315. 4092  goto 233
  316. 4094  '***1986N SORRELLS***
  317. 4095  j=2446864:f=0.378:q=1.7105:e0=1.0:w=70.677:n=74.064:i=160.600
  318. 4096  mag=7:nf=4:j9=j:f9=f:rem Quelle:Privatmitteilung P.Schmeer
  319. 4097  goto 233
  320. 4499  '***1984 QA***
  321. 4500  j=2446219:f=0.5684:q=0.526131:e0=0.468462:w=54.8416:n=152.0502:i=9.9219
  322. 4502  j9=j:f9=f:rem Quelle:B.G.Marsden(SAO),IAUC#4095
  323. 4504  goto 233
  324. 4509  '***1986 DA***
  325. 4510  j=2446526:f=0.7487:q=1.168213:e0=0.539019:w=123.2482:n=66.4558:i=4.1631
  326. 4512  j9=j:f9=f:rem Quelle:T.Urata(Tokio),IAUC#4181
  327. 4514  goto 233
  328. ə